home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE06 / INTERNAL / TESTFORM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-19  |  2.3 KB  |  91 lines
  1. unit Testform;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, DOSInfo;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     GroupBox1: TGroupBox;
  12.     Label1: TLabel;
  13.     Label2: TLabel;
  14.     Label3: TLabel;
  15.     FlopTypeB: TLabel;
  16.     FlopTypeA: TLabel;
  17.     FlopCount: TLabel;
  18.     GroupBox2: TGroupBox;
  19.     DriveList: TComboBox;
  20.     Label4: TLabel;
  21.     TheLabel: TEdit;
  22.     Label5: TLabel;
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure TheLabelKeyPress(Sender: TObject; var Key: Char);
  25.     procedure DriveListChange(Sender: TObject);
  26.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  27.   private
  28.     { Private declarations }
  29.   public
  30.     { Public declarations }
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. procedure TForm1.FormCreate(Sender: TObject);
  41. var
  42.     i: Char;
  43. begin
  44.     { Set up the various labels }
  45.     FlopCount.Caption := IntToStr (GetFloppyDriveCount);
  46.     FlopTypeA.Caption := IntToStr (GetFloppyDriveType (0)) + ' KBytes';
  47.     FlopTypeB.Caption := IntToStr (GetFloppyDriveType (1)) + ' KBytes';
  48.  
  49.     for i := 'C' to 'Z' do
  50.         if GetDriveType (Ord (i) - Ord ('A')) = Drive_Fixed then
  51.             DriveList.Items.Add (Format ('Drive %s:', [i]));
  52.  
  53.     DriveList.ItemIndex := 0;
  54.     DriveListChange (Sender);
  55. end;
  56.  
  57. procedure TForm1.TheLabelKeyPress(Sender: TObject; var Key: Char);
  58. begin
  59.     Key := UpCase (Key);
  60. end;
  61.  
  62. procedure TForm1.DriveListChange(Sender: TObject);
  63. var
  64.     s: String;
  65. begin
  66.     s := Copy (DriveList.Items [DriveList.ItemIndex], 7, 1);
  67.     TheLabel.Text := GetDriveLabel (Ord (s[1]) - $40);
  68. end;
  69.  
  70. procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
  71. var
  72.     s: String;
  73.     drive: Integer;
  74. begin
  75.     if Ord (Key) = vk_Return then
  76.     begin
  77.         Key := #0;
  78.         s := Copy (DriveList.Items [DriveList.ItemIndex], 7, 1);
  79.         drive := Ord (s[1]) - $40;
  80.         if (TheLabel.Text = '') and (GetDriveLabel (drive) <> '') then
  81.         begin
  82.             if MessageDlg (Format ('Remove drive label for drive %s: ?', [s [1]]),
  83.                            mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  84.                 SetDriveLabel (drive, '');
  85.         end
  86.         else SetDriveLabel (drive, TheLabel.Text);
  87.     end;
  88. end;
  89.  
  90. end.
  91.